home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / gs24src.zip / GS_FONTS.PS < prev    next >
Text File  |  1992-03-05  |  13KB  |  414 lines

  1. %    Copyright (C) 1990, 1992 Aladdin Enterprises.  All rights reserved.
  2. %    Distributed by Free Software Foundation, Inc.
  3. %
  4. % This file is part of Ghostscript.
  5. %
  6. % Ghostscript is distributed in the hope that it will be useful, but
  7. % WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  8. % to anyone for the consequences of using it or for whether it serves any
  9. % particular purpose or works at all, unless he says so in writing.  Refer
  10. % to the Ghostscript General Public License for full details.
  11. %
  12. % Everyone is granted permission to copy, modify and redistribute
  13. % Ghostscript, but only under the conditions described in the Ghostscript
  14. % General Public License.  A copy of this license is supposed to have been
  15. % given to you along with Ghostscript so you can know your rights and
  16. % responsibilities.  It should be in a file named COPYING.  Among other
  17. % things, the copyright notice and this notice must be preserved on all
  18. % copies.
  19.  
  20. % Font initialization for Ghostscript.
  21.  
  22. % Ghostscript fonts have essentially the same contents as Adobe Type 1 fonts,
  23. % except that the external form doesn't use eexec encryption.
  24. % Someday there will be GNU documentation that describes this format.
  25. % Until then, you'll have to either get a copy of Adobe's book, or read
  26. % the Ghostscript code.  The interpreter for Type 1 fonts, which reveals
  27. % most of their structure, is in the file gstype1.c.
  28.  
  29.  
  30. % Define the default font.
  31. /defaultfontname /Ugly def
  32.  
  33.  
  34. % Internal procedure to load the font name -> font file name map
  35. % if it isn't loaded already, and push it on the stack.
  36. /Fontmap
  37.  { /FontFileMap where
  38.     { /FontFileMap get }
  39.     { (Fontmap) findlibfile not
  40.        { (Can't find ) print print (!\n) print stop }
  41.       if exch pop
  42.  
  43.       FontDirectory maxlength dict exch
  44.       2 dict begin
  45.         mark exch 2 index exch
  46.     /;
  47.      { % The stack contains a mark, the dictionary, the font name,
  48.        % the file name, and additional information about the font.
  49.        counttomark 3 sub { pop } repeat put
  50.        1 index
  51.      } bind def
  52.     run
  53.       end
  54.       pop pop        % pop the mark and the copy of the dictionary
  55.       userdict exch /FontFileMap exch put
  56.       FontFileMap
  57.      }
  58.    ifelse
  59.  } bind def
  60.  
  61.  
  62. % Ghostscript optionally can load individual CharStrings as they are needed.
  63. % (This is intended primarily for machines with very small memories.)
  64. % This happens if DISKFONTS is true.  In this case, we define another
  65. % dictionary parallel to FontDirectory that retains an open file
  66. % for every font loaded.
  67. DISKFONTS
  68.  { /FontFileDirectory FontDirectory maxlength dict def
  69.  }
  70. if
  71.  
  72.  
  73. % Define definefont.  This is a procedure built on an operator that
  74. % does all the error checking and key insertion.
  75. /.buildfontdict 3 dict
  76.     /.buildfont0 where { pop dup 0 /.buildfont0 load put } if
  77.     /.buildfont1 where { pop dup 1 /.buildfont1 load put } if
  78.     /.buildfont3 where { pop dup 3 /.buildfont3 load put } if
  79. def
  80. /definefont
  81.  { 1 dict begin count /d exch def    % save stack depth in case of error
  82.     { dup /FontType get .buildfontdict exch get exec
  83.       DISKFONTS
  84.        { FontFileDirectory 2 index known
  85.           { dup /FontFile FontFileDirectory 4 index get put
  86.       }
  87.      if
  88.        }
  89.       if
  90.       readonly
  91.     }
  92.    stopped
  93.     { count d sub { pop } repeat end /invalidfont signalerror }
  94.     { end dup FontDirectory 4 2 roll put }
  95.    ifelse
  96.  } odef
  97.  
  98.  
  99. % Ghostscript optionally can load individual CharStrings as they are needed.
  100. % (This is intended primarily for machines with very small memories.)
  101. % Initially, the character definition is the file position of the definition;
  102. % this gets replaced with the actual CharString.
  103. % Note that if we are loading characters lazily, CharStrings is writable.
  104.  
  105. % _Cstring must be long enough to hold the longest CharString for
  106. % a character defined using seac.  This is lenIV + 4 * 5 (for the operands
  107. % of sbw, assuming div is not used) + 2 (for sbw) + 3 * 5 (for the operands
  108. % of seac other than the character codes) + 2 * 2 (for the character codes)
  109. % + 2 (for seac), i.e., lenIV + 43.
  110.  
  111. /_Cstring 60 string def
  112.  
  113. % When we initially load the font, we call
  114. %    <index|charname> <length> /readstring|/readhexstring skip_C
  115. % to skip over each character definition and return the file position instead.
  116. % This substitutes for the procedure
  117. %    <length> string currentfile exch read[hex]string pop
  118. % What we actually store is fileposition * 1000 + length,
  119. %   negated if the string is stored in binary form.
  120.  
  121. /skip_C
  122.  { load exch dup 1000 ge 3 index type /nametype ne or
  123.     { % This is a Subrs string, or the string is so long we can't represent
  124.       % its length.  Load it now.
  125.       currentfile 3 1 roll string exch exec pop
  126.     }
  127.     { % Record the position and length, and skip the string.
  128.       dup currentfile fileposition 1000 mul add
  129.       2 index /readstring load eq { neg } if
  130.       3 1 roll
  131.       dup _Cstring length idiv
  132.        { currentfile _Cstring 3 index exec pop pop
  133.        } repeat
  134.       _Cstring length mod _Cstring exch 0 exch getinterval
  135.       currentfile exch 3 -1 roll exec pop pop
  136.     }
  137.    ifelse
  138.  } bind def
  139.  
  140. % Type1BuildChar calls load_C to actually load the character definition.
  141.  
  142. /load_C        % charindex fileposandlength ->
  143.  { exch Encoding exch get exch
  144.    read_C type1addpath
  145.  } bind def
  146.  
  147. /read_C        % charname fileposandlength -> charstring
  148.  { dup abs 1000 idiv FontFile exch setfileposition
  149.    CharStrings 3 1 roll
  150.    dup 0 lt
  151.     { neg 1000 mod string FontFile exch readstring }
  152.     { 1000 mod string FontFile exch readhexstring }
  153.    ifelse pop
  154.    dup 4 1 roll put
  155. % If the character is defined with seac, load its components now.
  156.    dup mark exch seac_C
  157.    counttomark
  158.     { StandardEncoding exch get dup CharStrings exch get
  159.       dup type /integertype eq { read_C } { pop } ifelse pop
  160.     } repeat
  161.    pop        % the mark
  162.  } bind def
  163.  
  164. /seac_C        % charstring -> achar bchar ..or nothing..
  165.  { dup length _Cstring length le
  166.     { 4330 exch _Cstring type1decrypt exch pop
  167.       dup dup length 2 sub 2 getinterval <0c06> eq    % seac
  168.        { dup length
  169.          Private /lenIV known { Private /lenIV get } { 4 } ifelse
  170.      exch 1 index sub getinterval
  171. % Parse the string just enough to extract the seac information.
  172. % We assume that the only possible operators are hsbw, sbw, and seac,
  173. % and that there are no 5-byte numbers.
  174.      mark 0 3 -1 roll
  175.       { exch
  176.          { { dup 32 lt
  177.               { pop 0 }
  178.           { dup 247 lt
  179.              { 139 sub 0 }
  180.              { dup 251 lt
  181.             { 247 sub 256 mul 108 add 1 1 }
  182.             { 251 sub -256 mul -108 add -1 1 }
  183.                ifelse
  184.              }
  185.             ifelse
  186.           }
  187.          ifelse
  188.            }            % 0
  189.            { mul add 0 }        % 1
  190.          }
  191.         exch get exec
  192.       }
  193.      forall pop
  194.      counttomark 1 add 2 roll cleartomark    % pop all but achar bchar
  195.        }
  196.        { pop    % not seac
  197.        }
  198.       ifelse
  199.     }
  200.     { pop    % punt
  201.     }
  202.    ifelse
  203.  } bind def
  204.  
  205. % Define an auxiliary procedure for loading a font.
  206. % If DISKFONTS is true:
  207. %    - Prevent the CharStrings from being made read-only.
  208. %    - Substitute a different CharString-reading procedure.
  209. % If the body of the font is encrypted with eexec, this is disabled,
  210. % because the implicit 'systemdict begin' hides the redefinitions.
  211. % We assume that:
  212. %    - The magic procedures (-|, -!, |-, and |) are defined with
  213. %    executeonly or readonly;
  214. %    - The contents of the reading procedures are as defined in bdftops.ps;
  215. %    - The font ends with
  216. %    <font> <Private> <CharStrings>
  217. %    readonly put noaccess|readonly put
  218. 4 dict begin
  219.  /dict            % leave room for FontFile
  220.   { 1 add dict
  221.   } bind def
  222.  /executeonly        % for reading procedures
  223.   { readonly
  224.   } def
  225.  /noaccess        % for Subrs strings and Private dictionary
  226.   { readonly
  227.   } def
  228.  /readonly        % for procedures and CharStrings dictionary
  229.   {    % We want to take the following non-standard actions here:
  230.       %   - If the operand is the CharStrings dictionary, do nothing;
  231.     %   - If the operand is a number (a file position replacing the
  232.     %    actual CharString), do nothing;
  233.     %   - If the operand is either of the reading procedures (-| or -!),
  234.     %    substitute a different one.
  235.     dup type /dicttype eq        % CharStrings or Private
  236.      { 1 index /CharStrings ne { readonly } if }
  237.      { dup type /arraytype eq        % procedure or data array
  238.         { dup length 5 eq 1 index xcheck and
  239.        { dup 0 get /string eq
  240.          1 index 1 get /currentfile eq and
  241.          1 index 2 get /exch eq and
  242.          1 index 3 get dup /readstring eq exch /readhexstring eq or and
  243.          1 index 4 get /pop eq and
  244.           { 3 get cvlit /skip_C cvx 2 packedarray cvx
  245.           }
  246.           { readonly
  247.           }
  248.          ifelse
  249.        }
  250.        { readonly
  251.        }
  252.       ifelse
  253.     }
  254.     { dup type /stringtype eq    % must be a Subr string
  255.        { readonly }
  256.       if
  257.     }
  258.        ifelse
  259.      }
  260.     ifelse
  261.   } bind def
  262. currentdict end /.loadfontdict exch def
  263. /.loadfont        % <file> .loadfont ->
  264.  { mark exch systemdict begin
  265.    DISKFONTS { .loadfontdict begin } if
  266.     % We can't just use `run', because we want to check for
  267.     % .PFB files.  We can't save the packing status anywhere,
  268.     % so we need two separate control paths.
  269.    currentpacking
  270.     { false setpacking
  271.        { dup read not { -1 } if
  272.          2 copy unread 16#80 eq { /PFBDecode filter } if
  273.      cvx exec
  274.        } stopped    % split up `execute'
  275.       true setpacking
  276.       $error /newerror get and {handleerror} if
  277.     }
  278.     {  { dup read not { -1 } if
  279.          2 copy unread 16#80 eq { /PFBDecode filter } if
  280.      cvx exec
  281.        } execute
  282.     }
  283.    ifelse
  284.    DISKFONTS { end } if
  285.    end cleartomark
  286.  } bind def
  287.  
  288. % Define findfont so it tries to load a font if it's not found.
  289. /findfont
  290.  {
  291.     % If the key is a string, convert it to a name for lookup.
  292.     dup type /stringtype eq { cvn } if
  293.  
  294.     % If the font isn't in FontDirectory already, load it.
  295.     dup FontDirectory exch known
  296.      { FontDirectory exch get
  297.      }
  298.      { dup        % save the font name on the stack
  299.  
  300.        % Push the font name -> font file name map on the stack,
  301.        % loading it if necessary.
  302.        Fontmap
  303.  
  304.        % Read the file name from the map.
  305.        % (The stack contains the font name and the font file map.)
  306.        1 index known not
  307.         { QUIET not
  308.            { (Substituting ) print defaultfontname cvx =only
  309.              ( for unknown font ) print == flush
  310.            } { pop } ifelse
  311.           pop defaultfontname findfont
  312.         }
  313.         { dup Fontmap exch get
  314.  
  315.           % If we can't find the file, substitute for the font.
  316.           findlibfile
  317.            { DISKFONTS
  318.               { 1 index (r) file
  319.             FontFileDirectory exch 4 index exch put
  320.           }
  321.              if
  322.              QUIET not
  323.           { (Loading ) print 2 index =only
  324.             ( font from ) print exch print (... ) print flush }
  325.           { exch pop }
  326.          ifelse exch pop
  327.          .loadfont
  328.          QUIET not
  329.           { vmstatus 3 { =only ( ) print } repeat
  330.             (done.\n) print flush
  331.           } if
  332.          % Check to make sure the font was actually loaded.
  333.          dup FontDirectory exch known
  334.           { findfont
  335.           }
  336.           { (Loading ) print cvx =only
  337.             ( font failed, substituting )print defaultfontname cvx =only
  338.             (.\n) print flush
  339.             defaultfontname findfont
  340.           }
  341.          ifelse
  342.            }
  343.            { 1 index defaultfontname eq
  344.           { (Can't find default font!\n) print
  345.             pop pop NullFont
  346.           }
  347.           { (Can't find font file ) print print
  348.             (, substituting ) print defaultfontname cvx =only
  349.             (.\n) print flush
  350.             pop pop defaultfontname findfont
  351.           }
  352.          ifelse
  353.            }
  354.           ifelse
  355.         }
  356.        ifelse
  357.  
  358.      } ifelse
  359.  
  360.  } odef % bind def
  361.  
  362.  
  363. % The CharStrings for a Ghostscript font are a dictionary in which
  364. % the key is the character name, and the value is a compressed
  365. % representation of a path, as produced by type1imagepath.
  366. % For detailed information, see the book
  367. % "Adobe Type 1 Font Format", published by Adobe Systems Inc.
  368.  
  369. % Here is the BuildChar implementation
  370. % for Type 1 (Ghostscript standard) fonts.
  371. % The name Type1BuildChar is known to the interpreter.
  372.  
  373. /Type1BuildChar
  374.  { exch begin
  375.     dup Encoding exch get
  376.     dup CharStrings exch known not
  377.      { QUIET not
  378.         { (Substituting .notdef for ) print = flush
  379.     } { pop } ifelse
  380.        /.notdef
  381.      } if
  382.     currentdict /Metrics known
  383.      { dup Metrics exch known
  384.         { dup Metrics exch get .setmetrics } if
  385.      } if
  386.     CharStrings exch get
  387.     PaintType 0 ne
  388.      { 1 setmiterlimit 1 setlinejoin 1 setlinecap
  389.        currentdict /StrokeWidth known { StrokeWidth } { 0 } ifelse
  390.        setlinewidth
  391.      } if
  392.     dup type /stringtype eq        % encoded outline
  393.      { type1addpath pop }        % does a fill or stroke
  394.      { dup type /integertype eq        % file position for lazy loading
  395.         { load_C
  396.     }
  397.     { currentdict end systemdict begin begin
  398.       exec
  399.       end
  400.     }
  401.        ifelse
  402.      }
  403.     ifelse
  404.    end
  405.  } bind def
  406.  
  407.  
  408.  
  409. % Define a procedure to load all known fonts.
  410. % This isn't likely to be very useful.
  411. /loadallfonts
  412.  { Fontmap { pop findfont pop } forall
  413.  } bind def
  414.